home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / rotate2a / dibujawm.bas < prev    next >
Encoding:
BASIC Source File  |  1999-10-18  |  7.7 KB  |  209 lines
  1. Attribute VB_Name = "DibujaWMF"
  2. '--------------------------------------------------------------
  3. ' Author: Emilio Aguirre
  4. ' Date  : 5/01/98
  5. ' Prog  : DibujaWMF
  6. ' Desc  : Rotate a Windows Metafile
  7. '--------------------------------------------------------------
  8. Option Explicit
  9. '--------------------------------------------------------------
  10. ' Constants Definition
  11. '--------------------------------------------------------------
  12. Public Const PI = 3.14159265358979
  13.  
  14. Public Const META_ANIMATEPALETTE = &H436
  15. Public Const META_ARC = &H817
  16. Public Const META_BITBLT = &H922
  17. Public Const META_CREATEBRUSHINDIRECT = &H2FC
  18. Public Const META_CREATEFONTINDIRECT = &H2FB
  19. Public Const META_CREATEPALETTE = &HF7
  20. Public Const META_CREATEPATTERNBRUSH = &H1F9
  21. Public Const META_CREATEPENINDIRECT = &H2FA
  22. Public Const META_CREATEREGION = &H6FF
  23. Public Const META_CHORD = &H830
  24. Public Const META_DELETEOBJECT = &H1F0
  25. Public Const META_DIBBITBLT = &H940
  26. Public Const META_DIBCREATEPATTERNBRUSH = &H142
  27. Public Const META_DIBSTRETCHBLT = &HB41
  28. Public Const META_ELLIPSE = &H418
  29. Public Const META_ESCAPE = &H626
  30. Public Const META_EXCLUDECLIPRECT = &H415
  31. Public Const META_EXTFLOODFILL = &H548
  32. Public Const META_EXTTEXTOUT = &HA32
  33. Public Const META_FILLREGION = &H228
  34. Public Const META_FLOODFILL = &H419
  35. Public Const META_FRAMEREGION = &H429
  36. Public Const META_INTERSECTCLIPRECT = &H416
  37. Public Const META_INVERTREGION = &H12A
  38. Public Const META_LINETO = &H213
  39. Public Const META_MOVETO = &H214
  40. Public Const META_OFFSETCLIPRGN = &H220
  41. Public Const META_OFFSETVIEWPORTORG = &H211
  42. Public Const META_OFFSETWINDOWORG = &H20F
  43. Public Const META_PAINTREGION = &H12B
  44. Public Const META_PATBLT = &H61D
  45. Public Const META_PIE = &H81A
  46. Public Const META_POLYGON = &H324
  47. Public Const META_POLYLINE = &H325
  48. Public Const META_POLYPOLYGON = &H538
  49. Public Const META_REALIZEPALETTE = &H35
  50. Public Const META_RECTANGLE = &H41B
  51. Public Const META_RESIZEPALETTE = &H139
  52. Public Const META_RESTOREDC = &H127
  53. Public Const META_ROUNDRECT = &H61C
  54. Public Const META_SAVEDC = &H1E
  55. Public Const META_SCALEVIEWPORTEXT = &H412
  56. Public Const META_SCALEWINDOWEXT = &H410
  57. Public Const META_SELECTCLIPREGION = &H12C
  58. Public Const META_SELECTOBJECT = &H12D
  59. Public Const META_SELECTPALETTE = &H234
  60. Public Const META_SETBKCOLOR = &H201
  61. Public Const META_SETBKMODE = &H102
  62. Public Const META_SETDIBTODEV = &HD33
  63. Public Const META_SETMAPMODE = &H103
  64. Public Const META_SETMAPPERFLAGS = &H231
  65. Public Const META_SETPALENTRIES = &H37
  66. Public Const META_SETPIXEL = &H41F
  67. Public Const META_SETPOLYFILLMODE = &H106
  68. Public Const META_SETRELABS = &H105
  69. Public Const META_SETROP2 = &H104
  70. Public Const META_SETSTRETCHBLTMODE = &H107
  71. Public Const META_SETTEXTALIGN = &H12E
  72. Public Const META_SETTEXTCOLOR = &H209
  73. Public Const META_SETTEXTCHAREXTRA = &H108
  74. Public Const META_SETTEXTJUSTIFICATION = &H20A
  75. Public Const META_SETVIEWPORTEXT = &H20E
  76. Public Const META_SETVIEWPORTORG = &H20D
  77. Public Const META_SETWINDOWEXT = &H20C
  78. Public Const META_SETWINDOWORG = &H20B
  79. Public Const META_STRETCHBLT = &HB23
  80. Public Const META_STRETCHDIB = &HF43
  81. Public Const META_TEXTOUT = &H521
  82.  
  83. '--------------------------------------------------------------
  84. ' API Types
  85. '--------------------------------------------------------------
  86. Type RECT
  87.         Left As Long
  88.         Top As Long
  89.         Right As Long
  90.         Bottom As Long
  91. End Type
  92.  
  93. Type HANDLETABLE
  94.         objectHandle(1) As Long
  95. End Type
  96.  
  97. Type METARECORD
  98.         rdSize As Long
  99.         rdFunction As Integer
  100.         rdParm(1) As Integer
  101. End Type
  102.  
  103. Type POINT
  104.         x As Integer
  105.         y As Integer
  106. End Type
  107. '--------------------------------------------------------------
  108. ' API Declare Section
  109. '--------------------------------------------------------------
  110. Declare Function EnumMetaFile Lib "gdi32" (ByVal hdc As Long, ByVal hMetafile As Long, ByVal lpMFEnumProc As Long, ByVal lPARAM As Long) As Long
  111. Declare Function PlayMetaFileRecord Lib "gdi32" (ByVal hdc As Long, lpHandletable As HANDLETABLE, lpMetaRecord As METARECORD, ByVal nHandles As Long) As Long
  112. Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)
  113. Declare Function PlayEnhMetaFile Lib "gdi32" (ByVal hdc As Long, ByVal hemf As Long, lpRect As RECT) As Long
  114.  
  115. '--------------------------------------------------------------
  116. ' Variable Declaration
  117. '--------------------------------------------------------------
  118. Public Angle As Integer      'Rotation Angle
  119.  
  120. Function rot(P As POINT, ByVal Angle As Double) As POINT
  121. '--------------------------------------------------------------
  122. 'This function rotates a point P (x,y)
  123. '--------------------------------------------------------------
  124. Dim radians As Double
  125. radians = (Angle * PI) / 180 'Convert the angle to radians
  126. rot.x = P.x * Cos(radians) + (P.y * -Sin(radians))
  127. rot.y = P.x * Sin(radians) + (P.y * Cos(radians))
  128. End Function
  129.  
  130. Public Function EnumMetaRecord(ByVal DC As Long, ByRef lphTable As HANDLETABLE, ByRef lpMFR As METARECORD, ByVal nObj As Integer, ByVal lPARAM As Long) As Integer
  131. '-----------------------------------------------------------
  132. Dim i As Integer
  133. Dim j As Integer
  134. Dim k As Integer
  135. Dim l As Integer
  136. Dim Address As Long
  137. Dim pt(3) As POINT
  138. Dim dx As Integer
  139. Dim dy As Integer
  140. '-----------------------------------------------------------
  141. Select Case lpMFR.rdFunction
  142.   Case META_LINETO              'Rotate a line
  143.     pt(0).x = lpMFR.rdParm(0)
  144.     pt(0).y = lpMFR.rdParm(1)
  145.     pt(0) = rot(pt(0), Angle)
  146.     lpMFR.rdParm(0) = pt(0).x
  147.     lpMFR.rdParm(1) = pt(0).y
  148.   Case META_SETPIXEL
  149.     Address = VarPtr(lpMFR)
  150.     CopyMemory pt(0).y, ByVal Address + 8, 2
  151.     CopyMemory pt(0).x, ByVal Address + 10, 2
  152.     pt(0) = rot(pt(0), Angle)
  153.     CopyMemory ByVal Address + 8, pt(0).y, 2
  154.     CopyMemory ByVal Address + 10, pt(0).x, 2
  155.   Case META_POLYLINE, META_POLYGON    'Rotate a Polyline, Rotate a Polygon
  156.     Address = VarPtr(lpMFR)
  157.     For i = 0 To lpMFR.rdParm(0) - 1
  158.       CopyMemory pt(0).y, ByVal Address + 8 + (i * 4), 2
  159.       CopyMemory pt(0).x, ByVal Address + 10 + (i * 4), 2
  160.       pt(0) = rot(pt(0), Angle)
  161.       CopyMemory ByVal Address + 8 + (i * 4), pt(0).y, 2
  162.       CopyMemory ByVal Address + 10 + (i * 4), pt(0).x, 2
  163.     Next i
  164.   Case META_POLYPOLYGON
  165.     Address = VarPtr(lpMFR)
  166.     j = lpMFR.rdParm(0)
  167.     l = 0
  168.     For k = 0 To j - 1
  169.       CopyMemory i, ByVal Address + 8 + (k * 2), 2
  170.       l = l + i
  171.     Next k
  172.     For i = 0 To l - 1
  173.       CopyMemory pt(0).y, ByVal Address + 8 + (j * 2) + (i * 4), 2
  174.       CopyMemory pt(0).x, ByVal Address + 10 + (j * 2) + (i * 4), 2
  175.       pt(0) = rot(pt(0), Angle)
  176.       CopyMemory ByVal Address + 8 + (j * 2) + (i * 4), pt(0).y, 2
  177.       CopyMemory ByVal Address + 10 + (j * 2) + (i * 4), pt(0).x, 2
  178.     Next i
  179.   Case META_ELLIPSE, META_RECTANGLE
  180.     Address = VarPtr(lpMFR)
  181.     For i = 0 To 1
  182.       CopyMemory pt(i).y, ByVal Address + 6 + (i * 4), 2
  183.       CopyMemory pt(i).x, ByVal Address + 8 + (i * 4), 2
  184.     Next i
  185.     dx = Abs((pt(1).x - pt(0).x) / 2)
  186.     dy = Abs((pt(1).y - pt(0).y) / 2)
  187.     If (pt(1).x > pt(0).x) Then dx = dx * -1
  188.     If (pt(1).y > pt(0).y) Then dy = dy * -1
  189.     pt(2).x = pt(1).x + dx
  190.     pt(2).y = pt(1).y + dy
  191.     pt(2) = rot(pt(2), -Angle)
  192.     pt(0).x = pt(2).x - dx
  193.     pt(0).y = pt(2).y - dy
  194.     pt(1).x = pt(2).x + dx
  195.     pt(1).y = pt(2).y + dy
  196.     For i = 0 To 1
  197.       CopyMemory ByVal Address + 6 + (i * 4), pt(i).y, 2
  198.       CopyMemory ByVal Address + 8 + (i * 4), pt(i).x, 2
  199.     Next i
  200.  End Select
  201.  
  202. '-----------------------------------------------------------
  203. 'PlayMetaFileRecord DC, lphTable, lpMFR, nObj
  204. 'The line above must be a comment
  205. '-----------------------------------------------------------
  206. 'Continue with the next metafile record
  207. EnumMetaRecord = 1
  208. End Function
  209.